home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / sgwnd10 / misc.bas < prev    next >
Encoding:
BASIC Source File  |  1998-07-29  |  3.3 KB  |  112 lines
  1. Attribute VB_Name = "modMisc"
  2. Option Explicit
  3.  
  4. Public Const sSGWindowGUID = "{602B8906-F7EA-11D1-9825-204C4F4F5020}"
  5.  
  6. ' Win32 Registry functions
  7. Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
  8. Private Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpValueName As String, lpData As Any, lpcbData As Long) As Long
  9.  
  10. ' Registry API constants
  11. Private Const HKEY_CLASSES_ROOT = &H80000000
  12. Private Const HKEY_CURRENT_USER = &H80000001
  13. Private Const HKEY_LOCAL_MACHINE = &H80000002
  14. Private Const HKEY_USERS = &H80000003
  15. Private Const HKEY_PERFORMANCE_DATA = &H80000004
  16. Private Const HKEY_CURRENT_CONFIG = &H80000005
  17. Private Const HKEY_DYN_DATA = &H80000006
  18. Private Const ERROR_SUCCESS = 0&
  19.  
  20.  
  21.  
  22. Public Function ServerPathFromGUID(sGuid$) As String
  23.    Dim hKey As Long
  24.    Dim nRet As Long
  25.    Dim sKey As String
  26.    
  27.    ServerPathFromGUID = ""
  28.    sKey = "CLSID\" & sGuid & "\InProcServer32"
  29.    nRet = RegOpenKey(HKEY_CLASSES_ROOT, sKey, hKey)
  30.    If nRet = ERROR_SUCCESS Then
  31.       Dim nLen As Long
  32.       nRet = RegQueryValue(hKey, vbNullString, 0, nLen)
  33.       Dim sBuff As String
  34.       sBuff = Space(nLen)
  35.       nRet = RegQueryValue(hKey, vbNullString, ByVal sBuff, Len(sBuff))
  36.       ServerPathFromGUID = sBuff
  37.    End If
  38. End Function
  39.  
  40. Public Sub FillMessages(combo As ComboBox)
  41.    Dim tlib As tli.TypeLibInfo
  42.    Dim msgs As tli.ConstantInfo
  43.    Dim sFile As String
  44.    
  45.    combo.Clear
  46.    
  47.    ' Get SGWindow DLL path
  48.    sFile = ServerPathFromGUID(sSGWindowGUID)
  49.    If (Len(sFile) = 0) Then Exit Sub
  50.    
  51.    ' Get type library info for the SGWindow component
  52.    Set tlib = tli.TLIApplication.TypeLibInfoFromFile(sFile)
  53.    Set msgs = tlib.Constants.NamedItem("WinMsg")
  54.    
  55.    ' Fill combo
  56.    Dim ci As tli.MemberInfo
  57.    For Each ci In msgs.Members
  58.       combo.AddItem UCase(ci.name)
  59.    Next
  60.    combo.ListIndex = 0
  61. End Sub
  62.  
  63. Public Function GetMessageCode(sMsgName$) As Long
  64.    Dim tlib As New tli.TypeLibInfo
  65.    Dim msgs As tli.ConstantInfo
  66.    Dim sFile As String
  67.    
  68.    GetMessageCode = wm_NULL
  69.    
  70.    ' Get SGWindow DLL path
  71.    sFile = ServerPathFromGUID(sSGWindowGUID)
  72.    If (Len(sFile) = 0) Then Exit Function
  73.    
  74.    ' Get type library info for the SGWindow component
  75.    Set tlib = tli.TLIApplication.TypeLibInfoFromFile(sFile)
  76.    Set msgs = tlib.Constants.NamedItem("WinMsg")
  77.    
  78.    ' Find message
  79.    Dim ci As tli.MemberInfo
  80.    For Each ci In msgs.Members
  81.       If UCase(sMsgName) = UCase(ci.name) Then
  82.          GetMessageCode = ci.Value
  83.          Exit Function
  84.       End If
  85.    Next
  86. End Function
  87.  
  88. Public Function GetMessageName(msg As Long) As String
  89.    Dim tlib As New tli.TypeLibInfo
  90.    Dim msgs As tli.ConstantInfo
  91.    Dim sFile As String
  92.    
  93.    GetMessageName = "Unknown"
  94.    
  95.    ' Get SGWindow DLL path
  96.    sFile = ServerPathFromGUID(sSGWindowGUID)
  97.    If (Len(sFile) = 0) Then Exit Function
  98.    
  99.    ' Get type library info for the SGWindow component
  100.    Set tlib = tli.TLIApplication.TypeLibInfoFromFile(sFile)
  101.    Set msgs = tlib.Constants.NamedItem("WinMsg")
  102.    
  103.    ' Find message
  104.    Dim ci As tli.MemberInfo
  105.    For Each ci In msgs.Members
  106.       If msg = ci.Value Then
  107.          GetMessageName = UCase(ci.name)
  108.          Exit Function
  109.       End If
  110.    Next
  111. End Function
  112.